home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / SWAG9605.DDD / 0108_Texty Window Management.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-05-31  |  4.5 KB  |  235 lines
  1. unit txtwin;
  2.  
  3. INTERFACE
  4.  
  5. type
  6.   psave=^tsave;
  7.   tsave=record
  8.           x1,y1,x2,y2:word;
  9.           saved:pointer;
  10.           active:boolean;
  11.         end;
  12.   wintype=array[1..6]of char;
  13.   pwin=^twin;
  14.   twin=record
  15.          x1,y1,x2,y2:word;
  16.          f1,b1:byte;
  17.          screen:psave;
  18.          active:boolean;
  19.          wint:wintype;
  20.        end;
  21. const
  22.   normal:wintype=('┌','┐','└','┘','─','│');
  23.   double:wintype=('╔','╗','╚','╝','═','║');
  24.  
  25. procedure initback(var sav:psave);
  26. procedure saveback(var sav:psave;xx1,yy1,xx2,yy2:word);
  27. procedure resback(var sav:psave);
  28. procedure initwin(var win:pwin);
  29. procedure drawwin(var win:pwin; xx1,yy1,xx2,yy2:word; ff1,bb1:byte;wt:wintype);
  30. procedure shade(x1,x2,y:word);
  31. procedure closewin(var win:pwin);
  32. procedure redrawwin(var win:pwin);
  33.  
  34. IMPLEMENTATION
  35.  
  36. procedure initback(var sav:psave);
  37. begin
  38.   with sav^ do
  39.   begin
  40.     active:=false;
  41.     x1:=0; y1:=0; x2:=0; y2:=0;
  42.   end;
  43. end;
  44.  
  45. procedure saveback(var sav:psave;xx1,yy1,xx2,yy2:word);
  46. var
  47.   y,w,o:word;
  48. begin
  49.   with sav^ do
  50.   begin
  51.     if(active)then exit;
  52.     x1:=xx1; y1:=yy1;
  53.     x2:=xx2; y2:=yy2;
  54.     w:=succ(x2-x1)*2;
  55.     getmem(saved,w*succ(y2-y1));
  56.     active:=true;
  57.     o:=0;
  58.     for y:=y1 to y2 do
  59.     begin
  60.       move(mem[segb800:pred(y)*160+pred(x1)],mem[seg(saved^):ofs(saved^)+o],w);
  61.       inc(o,w);
  62.     end;
  63.   end;
  64. end;
  65.  
  66. procedure resback(var sav:psave);
  67. var y,w,o:word;
  68. begin
  69.   with sav^ do
  70.   begin
  71.     if not(active)then exit;
  72.     w:=succ(x2-x1)*2;
  73.     o:=0;
  74.     for y:=y1 to y2 do
  75.     begin
  76.       move(mem[seg(saved^):ofs(saved^)+o],mem[segb800:pred(y)*160+pred(x1)],w);
  77.       inc(o,w);
  78.     end;
  79.     freemem(saved,w*succ(y2-y1));
  80.     active:=false;
  81.     x1:=0; y1:=0; x2:=0; y2:=0;
  82.   end;
  83. end;
  84.  
  85. procedure initwin(var win:pwin);
  86. begin
  87.   with win^ do
  88.   begin
  89.     x1:=0; y1:=0; x2:=0; y2:=0;
  90.     f1:=0; b1:=0;
  91.     active:=false;
  92.     wint:=normal;
  93.   end;
  94. end;
  95.  
  96. function buildstr(const ch:char;const num:byte):string; assembler;
  97. asm
  98.   xor ch,ch
  99.   mov al,[num]
  100.   mov cl,al
  101.   les di,@result
  102.   stosb
  103.   jcxz @@exit
  104.   mov al,[&ch]
  105.   mov ah,al
  106.   shr cl,1
  107.   rep stosw
  108.   adc cl,cl
  109.   rep stosb
  110.   @@exit:
  111. end;
  112.  
  113. procedure str2scr(const s:string;const x,y:word;const c:byte); assembler;
  114. asm
  115.   push ds
  116.   dec [x]
  117.   dec [y]
  118.   mov es,segb800
  119.   mov di,[y]
  120.   mov bx,di
  121.   shl di,6
  122.   shl bx,4
  123.   add di,bx
  124.   add di,[x]
  125.   shl di,1
  126.   lds si,s
  127.   xor ch,ch
  128.   mov cl,ds:[si]
  129.   inc si
  130.   mov ah,[c]
  131.  @@loop:
  132.    lodsb
  133.    stosw
  134.    loop @@loop
  135.  @@exit:
  136.  pop ds
  137. end;
  138.  
  139. procedure drawwin(var win:pwin; xx1,yy1,xx2,yy2:word; ff1,bb1:byte;wt:wintype);
  140. var
  141.   tmp:string;
  142.   cnt:byte;
  143. begin
  144.   with win^ do
  145.   begin
  146.     if(active)then exit;
  147.     active:=true;
  148.     initback(screen);
  149.     x1:=xx1; y1:=yy1;
  150.     x2:=xx2; y2:=yy2;
  151.     f1:=ff1; b1:=bb1;
  152.     saveback(screen,x1,y1,x2,y2);
  153.     wint:=wt;
  154.   end;
  155.   tmp:=''; tmp:=wt[1];
  156.   if((xx2-xx1)>2)then tmp:=concat(tmp,buildstr(wt[5],pred(xx2-xx1)));
  157.   tmp:=concat(tmp,wt[2]);
  158.   str2scr(tmp,xx1,yy1,(bb1 shl 4)+ff1);
  159.   tmp[1]:=wt[3]; tmp[ord(tmp[0])]:=wt[4];
  160.   str2scr(tmp,xx1,yy2,(bb1 shl 4)+ff1);
  161.   tmp:=''; tmp:=wt[6];
  162.   if((xx2-xx1)>2)then tmp:=concat(tmp,buildstr(' ',pred(xx2-xx1)));
  163.   tmp:=concat(tmp,wt[6]);
  164.   if((yy2-yy1)>2)then
  165.   begin
  166.     for cnt:=1 to pred(yy2-yy1)do
  167.       str2scr(tmp,xx1,yy1+cnt,(bb1 shl 4)+ff1);
  168.   end;
  169. end;
  170.  
  171. procedure shade(x1,x2,y:word); assembler;
  172. asm
  173.   mov es,segb800
  174.   dec [x1]
  175.   dec [y]
  176.   mov cx,[x2]
  177.   sub cx,[x1]
  178.   mov di,[y]
  179.   mov bx,di
  180.   shl di,6
  181.   shl bx,4
  182.   add di,bx
  183.   shl di,1
  184.   add di,[x1]
  185.   add di,[x1]
  186.   inc di
  187.   @@loop:
  188.     mov al,es:[di]
  189.     sub al,112
  190.     mov es:[di],al
  191.     add di,2
  192.     dec cx
  193.     jnz @@loop
  194. end;
  195.  
  196. procedure closewin(var win:pwin);
  197. begin
  198.   with win^ do
  199.   begin
  200.     if not(active)then exit;
  201.     active:=false;
  202.     x1:=0; y1:=0; x2:=0; y2:=0;
  203.     f1:=0; b1:=0;
  204.     resback(screen);
  205.     wint:=normal;
  206.   end;
  207. end;
  208.  
  209. procedure redrawwin(var win:pwin);
  210. var
  211.   tmp:string;
  212.   c:byte;
  213. begin
  214.   with win^ do
  215.   begin
  216.     if not(active)then exit;
  217.     tmp:=''; tmp:=wint[1];
  218.     if((x2-x1)>2)then tmp:=concat(tmp,buildstr(wint[5],pred(x2-x1)));
  219.     tmp:=concat(tmp,wint[2]);
  220.     str2scr(tmp,x1,y1,(b1 shl 4)+f1);
  221.     tmp[1]:=wint[3]; tmp[ord(tmp[0])]:=wint[4];
  222.     str2scr(tmp,x1,y2,(b1 shl 4)+f1);
  223.     tmp:=''; tmp:=wint[6];
  224.     if((x2-x1)>2)then tmp:=concat(tmp,buildstr(' ',pred(x2-x1)));
  225.     tmp:=concat(tmp,wint[6]);
  226.     if((y2-y1)>2)then
  227.     begin
  228.       for c:=1 to pred(y2-y1)do
  229.         str2scr(tmp,x1,y1+c,(b1 shl 4)+f1);
  230.     end;
  231.   end;
  232. end;
  233.  
  234. begin
  235. end.